;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright (C) 2021 Maxime Devos
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later

;; Brief: Interface to the network size estimation service.
;; C author: Nathan Evans
;; Scheme author: Maxime Devos
;;
;; The Scheme implementation is _not_ based on the C implementation,
;; though the Scheme API is structured after the C API and slightly
;; extended.

(define-library (gnu gnunet nse client)
  (export estimate?
	  estimate:logarithmic-number-peers
	  estimate:number-peers
	  estimate:standard-deviation
	  estimate:timestamp
	  server?
	  connect
	  disconnect!
	  estimate)
  (import (only (rnrs base)
		begin define quote lambda case values expt = else apply
		and >=)
	  (only (rnrs control)
		when unless)
	  (only (rnrs records syntactic)
		define-record-type)
          (only (ice-9 atomic)
		make-atomic-box atomic-box-ref atomic-box-set!)
          (only (fibers)
		spawn-fiber)
	  (only (fibers conditions)
		make-condition wait wait-operation signal-condition!)
	  (only (fibers operations)
		choice-operation perform-operation)
	  (only (gnu extractor enum)
		symbol-value value->index)
	  (only (guile)
		define* const)
	  (only (gnu gnunet util struct)
		/:message-header)
	  (only (gnu gnunet utils bv-slice)
		make-slice/read-write slice-length)
          (only (gnu gnunet netstruct syntactic)
		read% set%! sizeof)
          (only (gnu gnunet mq handler)
		message-handler
		message-handlers)
          (only (gnu gnunet mq)
		send-message! close-queue!)
          (only (gnu gnunet mq-impl stream)
		connect/fibers)
	  (only (gnu gnunet mq error-reporting)
		report-error)
          (gnu gnunet message protocols)
          (only (gnu gnunet nse struct)
		/:msg:nse:estimate))
  (begin
    (define-record-type (<estimate> %make-estimate estimate?)
      (fields (immutable logarithmic-number-peers
			 %estimate:logarithmic-number-peers)
	      (immutable standard-deviation %estimate:standard-deviation)
	      (immutable timestamp %estimate:timestamp))
      (sealed #t)
      (opaque #t))

    (define-record-type (<server> %make-server server?)
      ;; Atomic box of <estimate>
      (fields (immutable estimate/box server-estimate/box)
	      ;; Atomic box of boolean.  Initially #f.  Set this
	      ;; to #t before signalling request-close-condition.
	      (immutable request-close?/box
			 server-request-close?/box)
	      (immutable request-close-condition
			 server-request-close-condition)))

    (define (estimate server)
      "Return the current estimate of the number of peers on the network,
in some unspecified format.  Alternatively, if no estimate is available
yet, return @code{#false}."
      (atomic-box-ref (server-estimate/box server)))

    (define (estimate:logarithmic-number-peers estimate)
      "Return the logarithm (base 2) of the number of peers on the network
in @var{estimate} as a positive flonum (possibly zero or infinite)."
      (%estimate:logarithmic-number-peers estimate))

    (define (estimate:standard-deviation estimate)
      "Return the standard deviation of the logarithmic estimate
of the number of peers of the last 64 rounds as a positive flonum
(possibly zero or infinite)."
      (%estimate:standard-deviation estimate))

    (define (estimate:number-peers estimate)
      "Return the estimate of the number of peers on the network in
@var{estimate} as a strictly-positive flonum, at least @code{1.0}
and possibly infinite."
      (expt 2.0 (estimate:logarithmic-number-peers estimate)))

    (define (estimate:timestamp estimate)
      "Return when the estimate @var{estimate} was made, as a standard GNUnet
timestamp."
      (%estimate:timestamp estimate))

    (define (disconnect! server)
      "Asynchronuously disconnect from the NSE server and stop reconnecting,
even if not connected.  This is an idempotent operation."
      (atomic-box-set! (server-request-close?/box server) #t)
      (signal-condition! (server-request-close-condition server)))

    ;; See 'connect'.
    (define* (reconnect estimate/box request-close?/box request-close-condition config
			#:key
			updated connected disconnected spawn #:rest rest)
      (define (handle-estimate! estimate-slice)
	(define estimate
	  (%make-estimate
	   (read% /:msg:nse:estimate '(size-estimate) estimate-slice)
	   (read% /:msg:nse:estimate '(std-deviation) estimate-slice)
	   (read% /:msg:nse:estimate '(timestamp) estimate-slice)))
	(atomic-box-set! estimate/box estimate)
	(when updated
	  (updated estimate)))
      (define handlers
	(message-handlers
	 (message-handler
	  (type (symbol-value message-type msg:nse:estimate))
	  ((interpose code) code)
	  ((well-formed? slice)
	   (and (= (slice-length slice)
		   (sizeof /:msg:nse:estimate '()))
		;; XXX: these two lines below are not tested
		(>= (read% /:msg:nse:estimate '(size-estimate) slice) 0)
		(>= (read% /:msg:nse:estimate '(std-deviation) slice) 0)))
	  ((handle! slice) (handle-estimate! slice)))))
      (define (send-start!)
	;; The service only starts sending estimates once
	;; /:msg:nse:start is sent.
	(define s (make-slice/read-write (sizeof /:message-header '())))
	(set%! /:message-header '(size) s (sizeof /:message-header '()))
	(set%! /:message-header '(type) s
	       (value->index (symbol-value message-type msg:nse:start)))
	(send-message! mq s))
      (define mq-defined (make-condition))
      (define mq-closed (make-condition))
      (define (error-handler error . arguments)
	(case error
	  ((connection:connected)
	   ;; Make sure the message queue is actually bound to the variable
	   ;; @var{mq} before calling @code{send-start!}, as @code{send-start!}
	   ;; uses @var{mq}.
	   (wait mq-defined)
	   (send-start!)
	   (when connected (connected)))
	  ((input:regular-end-of-file input:premature-end-of-file)
	   ;; Call 'reconnect' after 'disconnected'.  Otherwise,
	   ;; it is possible that 'connected' is called twice without
	   ;; a call to 'disconnected' in-between, which would presumably
	   ;; be confusing.
	   (signal-condition! mq-closed)
	   (when disconnected (disconnected))
	   ;; Don't reconnect after 'close-queue!'.  About races: it's not
	   ;; paramount we stop reconnecting immediately, but we should stop
	   ;; eventually after 'request-close?/box' is set and
	   ;; 'request-close-condition' is signalled, and 'request-close-handler'
	   ;; will take care of closing the new queue if it shouldn't have been
	   ;; created.
	   (unless (atomic-box-ref request-close?/box)
	     (apply reconnect estimate/box request-close?/box request-close-condition
		    config rest)))
	  ((connection:interrupted)
	   (values))
	  (else
	   ;; Weirdness.  Not much that can be done except report it and
	   ;; try to reconnect.  XXX untested code path, sleep a little?
	   (apply report-error error arguments)
	   (close-queue! mq))))
      ;; Only started after 'mq' is defined, so no need to wait for
      ;; 'mq-defined'.
      (define (request-close-handler)
	(perform-operation
	 (choice-operation
	  (wait-operation request-close-condition)
	  ;; Make sure the fiber exits after a reconnect.
	  (wait-operation mq-closed)))
	(close-queue! mq))
      (define mq (connect/fibers config "nse" handlers error-handler
				 #:spawn spawn))
      (signal-condition! mq-defined)
      (spawn request-close-handler))

    (define* (connect config #:key updated connected disconnected
		      (spawn spawn-fiber))
      "Connect to the NSE service in the background.

When connected, the thunk @var{connected} is called and estimates
will become available (but possibly not immediately).  When a new
estimate is available, the procedure @var{updated} is called.  This
procedure should accept the new estimate.   When disconnected, the
thunk @code{disconnected} and updates will be (temporarily) unavailable,
until connected again.  It is possible for @var{updated} to be called
shortly after calling @var{disconnected}.

The procedures @var{updated}, @var{connected} and @var{disconnected} are optional."
      (define estimate/box (make-atomic-box #f))
      (define request-close?/box (make-atomic-box #f))
      (define request-close-condition (make-condition))
      (reconnect estimate/box request-close?/box request-close-condition config
		 #:updated updated #:connected connected #:disconnected disconnected
		 #:spawn spawn)
      (%make-server estimate/box request-close?/box request-close-condition))))
